home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / tpop3.zip / MIME.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-15  |  12KB  |  544 lines
  1. unit Mime;
  2.  
  3. interface
  4.  
  5. uses Classes,SysUtils,Forms,Dialogs;
  6.  
  7. const
  8.   MaxChars = 57;
  9.  
  10. type
  11.   TBinBytes = array[1..MaxChars] of byte;
  12.   TTxtBytes = array[1..2*MaxChars] of byte;
  13.   T24Bits = array[0..8*MaxChars] of boolean;
  14.  
  15. EUUInvalidCharacter = class(Exception)
  16.   constructor Create;
  17. end;
  18.  
  19.  EMIMEError = class(Exception);
  20.  
  21. {$IFDEF UseHuge}
  22. TTextStream = class(TMemoryStream)
  23. public
  24.   procedure Write(const s : string);
  25.   procedure Read(var s : string);
  26. end;
  27. {$ENDIF}
  28.  
  29.   TBase64 = class
  30.   private
  31. {$IFDEF UseHuge}
  32.     TextStream : TTextStream;
  33. {$ELSE}
  34.     TextStream : TStringList;
  35. {$ENDIF}
  36.     Stream : TStream;
  37.     CurSection : byte;
  38.     A24Bits : T24Bits;
  39.     FOnProgress : TNotifyEvent;
  40.     FOnStart : TNotifyEvent;
  41.     FOnEnd : TNotifyEvent;
  42.     function GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  43.     procedure GenerateBinBytes(InS : string; BufPtr : pointer;
  44.                                var BytesGenerated : word);
  45.     function ByteFromTable(Ch : Char) : byte;
  46.     procedure DoProgress(Sender : TObject);
  47.     procedure DoStart(Sender : TObject);
  48.     procedure DoEnd(Sender : TObject);
  49.   public
  50.     Progress : Integer;
  51.     ProgressStep : Integer;
  52.     Canceled : boolean;
  53.     Table : string;
  54. {$IFDEF UseHuge}
  55.     constructor Create(AStream : TStream; ATextStream : TTextStream);
  56. {$ELSE}
  57.     constructor Create(AStream : TStream; ATextStream : TStringList);
  58. {$ENDIF}
  59.     procedure Encode;
  60.     procedure Decode;
  61.     property OnProgress : TNotifyEvent read FOnProgress
  62.                              write FOnProgress;
  63.     property OnStart : TNotifyEvent read FOnStart write FOnStart;
  64.     property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
  65.   end;
  66.  
  67.   TQuotedPrintable = class(TComponent)
  68.   private
  69.     { Private declarations }
  70.   protected
  71.     { Protected declarations }
  72.     Stream : TStream;
  73.     Lines : TStringList;
  74.     procedure ReplaceHiChars(var s : string);
  75.     procedure ReplaceHex(var s : string);
  76.     procedure ReformatParagraph(Buf : PChar; Len : Integer;
  77.                TL : TStringList);
  78.   public
  79.     { Public declarations }
  80.     Canceled : boolean;
  81.     constructor Create(AStream : TStream; ALines : TStringList);
  82.     procedure Encode;
  83.     procedure Decode;
  84.   published
  85.     { Published declarations }
  86.   end;
  87.  
  88. function GetContentType(const FileName : string) : string;
  89. function MakeUniqueID : string;
  90.  
  91. implementation
  92.  
  93. constructor EUUInvalidCharacter.Create;
  94. begin
  95.   inherited Create('Invalid character in the input file');
  96. end;
  97.  
  98. {$IFDEF UseHuge}
  99. {TTextStream}
  100. procedure TTextStream.Write(const s : string);
  101. var
  102.   Buf : array[0..255] of Char;
  103.   sLen : byte absolute s;
  104. begin
  105.   StrPCopy(@Buf,Concat(s,^M^J));
  106.   inherited Write(Buf,StrLen(@Buf));
  107. end;
  108.  
  109. procedure TTextStream.Read(var s : string);
  110. var
  111.   sLen : byte absolute s;
  112.   Ch : Char;
  113. begin
  114.   Ch:=#00; s:='';
  115.   repeat
  116.     inherited Read(Ch,1);
  117.     if not (Ch in [^M,^J]) then
  118.       s:=Concat(s,Ch);
  119.   until Ch=^J;
  120. end;
  121. {$ENDIF}
  122.  
  123. {implementation for TBase64}
  124. {$IFDEF UseHuge}
  125. constructor TBase64.Create(AStream : TStream; ATextStream : TTextStream);
  126. {$ELSE}
  127. constructor TBase64.Create(AStream : TStream; ATextStream : TStringList);
  128. {$ENDIF}
  129. begin
  130.   inherited Create;
  131.   Stream:=AStream;
  132.   TextStream:=ATextStream;
  133.   ProgressStep:=10;
  134.   Table:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  135.   FillChar(A24Bits,SizeOf(A24Bits),0);
  136. end;
  137.  
  138. procedure TBase64.DoProgress(Sender : TObject);
  139. begin
  140.   if Assigned(FOnProgress) then
  141.     FOnProgress(Sender);
  142. end;
  143.  
  144. procedure TBase64.DoStart(Sender : TObject);
  145. begin
  146.   if Assigned(FOnStart) then
  147.     FOnStart(Sender);
  148. end;
  149.  
  150. procedure TBase64.DoEnd(Sender : TObject);
  151. begin
  152.   if Assigned(FOnEnd) then
  153.     FOnEnd(Sender);
  154. end;
  155.  
  156. function TBase64.GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  157. var
  158.   i,j,k,b,m : word;
  159.   s : string;
  160. begin
  161.   k:=0;
  162.   FillChar(A24Bits,SizeOf(T24Bits),0);
  163.   for i:=1 to MaxChars do
  164.   begin
  165.     b:=tb[i];
  166.     for j:=7 DownTo 0 do
  167.     begin
  168.       m:=1 shl j;
  169.       if (b and m = m) then
  170.         A24Bits[k]:=true;
  171.       Inc(k);
  172.     end;
  173.   end;
  174.   s:=''; k:=0; m:=4*(MaxChars div 3);
  175.   for i:=1 to m do
  176.   begin
  177.     b:=0;
  178.     for j:=5 DownTo 0 do
  179.     begin
  180.       if A24Bits[k] then b:= b or (1 shl j);
  181.       Inc(k);
  182.     end;
  183.     s[i]:=Table[b+1];
  184.   end;
  185.   if (NumOfBytes=MaxChars) or (NumOfBytes mod 3=0) then
  186.      s[0]:=Char(4*NumOfBytes div 3)
  187.   else
  188.   begin
  189.     s[0]:=Char(4*NumOfBytes div 3+1);
  190.     while (Length(s) mod 4)<>0 do
  191.       s:=Concat(s,'=');
  192.   end;
  193.   Result:=s;
  194. end;
  195.  
  196. procedure TBase64.Encode;
  197. var
  198.   BytesRead : word;
  199.   ABinBytes : TBinBytes;
  200.   Total : LongInt;
  201. begin
  202.   DoStart(Self);
  203.   TextStream.Clear;
  204.   Progress:=0; Total:=0; Canceled:=false;
  205.   try
  206.     repeat
  207.       FillChar(ABinBytes,SizeOf(TBinBytes),0);
  208.       BytesRead:=Stream.Read(ABinBytes,MaxChars);
  209.       Inc(Total,BytesRead);
  210. {$IFDEF UseHuge}
  211.       TextStream.Write(GenerateTxtBytes(ABinBytes,BytesRead));
  212. {$ELSE}
  213.       TextStream.Add(GenerateTxtBytes(ABinBytes,BytesRead));
  214. {$ENDIF}
  215.       Progress:=Round(100*Total/Stream.Size);
  216.       if Progress mod ProgressStep = 0 then
  217.          DoProgress(Self);
  218.       Application.ProcessMessages;
  219.     until (BytesRead<MaxChars) or Canceled;
  220.   finally
  221.     Progress:=100;
  222.     DoProgress(Self);
  223.     if Canceled then TextStream.Clear;
  224.     DoEnd(Self);
  225.   end;
  226. end;
  227.  
  228. function TBase64.ByteFromTable(Ch : Char) : byte;
  229. var
  230.   i : byte;
  231. begin
  232.   i:=1;
  233.   while (Ch<>Table[i]) and (i<=64) do Inc(i);
  234.   if i>64 then
  235.   begin
  236.     if Ch='=' then Result:=0
  237.       else raise EUUInvalidCharacter.Create;
  238.   end;
  239.   Result:=i-1;
  240. end;
  241.  
  242. procedure TBase64.GenerateBinBytes(InS : string; BufPtr : pointer;
  243.                           var BytesGenerated : word);
  244. var
  245.   i,j,k,b,m : word;
  246.   InSLen : byte absolute InS;
  247.   ActualLen : byte;
  248. begin
  249.   FillChar(BufPtr^,MaxChars,0);
  250.   FillChar(A24Bits,SizeOf(T24Bits),0);
  251.   k:=0;
  252.   for i:=1 to InSLen do
  253.   begin
  254.     b:=ByteFromTable(InS[i]);
  255.     for j:=5 DownTo 0 do
  256.     begin
  257.       m:=1 shl j;
  258.       if (b and m = m) then
  259.         A24Bits[k]:=true;
  260.       Inc(k);
  261.     end;
  262.   end;
  263.   k:=0;
  264.   if InSLen<>4*MaxChars div 3 then
  265.   begin
  266.     ActualLen:=3*InSLen div 4;
  267.     while InS[InSLen]='=' do
  268.     begin
  269.       Dec(ActualLen);
  270.       Dec(InSLen);
  271.     end;
  272.   end
  273.   else
  274.     ActualLen:=MaxChars;
  275.   for i:=1 to ActualLen do
  276.   begin
  277.     b:=0;
  278.     for j:=7 DownTo 0 do
  279.     begin
  280.       if A24Bits[k] then b:= b or (1 shl j);
  281.       Inc(k);
  282.     end;
  283.     byte(PChar((PChar(BufPtr)+i-1))^):=b;
  284.   end;
  285.   BytesGenerated:=i;
  286. end;
  287.  
  288. procedure TBase64.Decode;
  289. var
  290.   ATxtBytes : TTxtBytes;
  291.   BytesGenerated : word;
  292.   Total : LongInt;
  293.   s : string;
  294.   p : pointer;
  295. {$IFNDEF UseHuge}
  296.   i : LongInt;
  297. {$ENDIF}
  298. begin
  299.   DoStart(Self);
  300.   Progress:=0;
  301.   Canceled:=false;
  302. {$IFNDEF UseHuge}
  303.   i:=0;
  304. {$ENDIF}
  305.   try
  306.     GetMem(p,MaxChars);
  307.     Total:=0;
  308.     repeat
  309.       FillChar(p^,MaxChars,0);
  310. {$IFDEF UseHuge}
  311.       TextStream.Read(s);
  312. {$ELSE}
  313.       s:=TextStream[i];
  314. {$ENDIF}
  315.       GenerateBinBytes(s,p,BytesGenerated);
  316.       Stream.Write(p^,BytesGenerated);
  317.       Inc(Total,BytesGenerated);
  318. {$IFDEF UseHuge}
  319.       Progress:=Round(100*Total/TextStream.Size);
  320. {$ELSE}
  321.       Progress:=Round(100*i/(TextStream.Count-1));
  322. {$ENDIF}
  323.       if Progress mod ProgressStep = 0 then
  324.          DoProgress(Self);
  325.       Application.ProcessMessages;
  326. {$IFDEF UseHuge}
  327.     until (TextStream.Position>=TextStream.Size) or Canceled;
  328. {$ELSE}
  329.       Inc(i);
  330.     until (i>=TextStream.Count);
  331. {$ENDIF}
  332.   finally
  333.     Progress:=100;
  334.     DoProgress(Self);
  335.     FreeMem(p,MaxChars);
  336.     DoEnd(Self);
  337.   end;
  338. end;
  339.  
  340. {implementation for TQuotedPrintable}
  341.  
  342. const
  343.   BufSize=$6000;
  344.  
  345. constructor TQuotedPrintable.Create(AStream : TStream; ALines : TStringList);
  346. begin
  347.   Stream:=AStream;
  348.   Lines:=ALines;
  349.   Canceled:=false;
  350. end;
  351.  
  352. procedure TQuotedPrintable.ReplaceHiChars(var s : string);
  353. var
  354.   sLen : byte absolute s;
  355.   i : byte;
  356. begin
  357.   i:=1;
  358.   while i<sLen do
  359.   begin
  360.     if Ord(s[i]) in [0..31,61,128..255] then
  361.     begin
  362.       Insert(Concat('=',IntToHex(Ord(s[i]),2)),s,i+1);
  363.       Delete(s,i,1);
  364.       Inc(i,2);
  365.     end;
  366.     Inc(i);
  367.   end;
  368. end;
  369.  
  370. procedure TQuotedPrintable.ReformatParagraph(Buf : PChar; Len : Integer;
  371.           TL : TStringList);
  372. var
  373.   i : Integer;
  374.   cp,sp : PChar;
  375.   s : string;
  376.   sLen : byte absolute s;
  377.   Finished : boolean;
  378. begin
  379.   sp:=Buf;
  380.   TL.Clear;
  381.   repeat
  382.     cp:=sp+Len;
  383.     Finished:=cp>StrEnd(Buf);
  384.     if Finished then cp:=StrEnd(Buf)
  385.     else
  386.     begin
  387.       while (cp^<>' ') and (cp>sp) do Dec(cp);
  388.       if cp=sp then
  389.         cp:=sp+Len;
  390.     end;
  391.     sLen:=cp-sp;
  392.     move(sp^,s[1],sLen);
  393.     if not Finished then s:=Concat(s,'=');
  394.     ReplaceHiChars(s);
  395.     TL.Add(s);
  396.     sp:=cp;
  397.   until Finished;
  398. end;
  399.  
  400. procedure TQuotedPrintable.Encode;
  401. var
  402.   j : Integer;
  403.   Ch : Char;
  404.   s : string;
  405.   Buf : PChar;
  406.   Finished : boolean;
  407.   TempLines : TStringList;
  408. begin
  409.   Buf:=StrAlloc(BufSize);
  410.   TempLines:=TStringList.Create;
  411.   try
  412.     repeat
  413.       {Read a paragraph}
  414.       j:=0;
  415.       FillChar(Buf^,BufSize,0);
  416.       repeat
  417.         if j>=BufSize then
  418.           raise EMIMEError.Create('Paragraph is too large');
  419.         Stream.Read(Ch,1);
  420.         if Stream.Position=Stream.Size then
  421.         begin
  422.           Finished:=true;
  423.           move(Ch,(Buf+j)^,1);
  424.           Inc(j);
  425.         end
  426.         else
  427.         if Ch in [^M,^J] then
  428.         begin
  429.           Finished:=true;
  430.           Stream.Read(Ch,1);
  431.           if not (Ch in [^M,^J])
  432.             then Stream.Position:=Stream.Position-1;
  433.         end
  434.         else
  435.         begin
  436.           Finished:=false;
  437.           move(Ch,(Buf+j)^,1);
  438.           Inc(j);
  439.         end;
  440.         Application.ProcessMessages;
  441.       until Finished;
  442.       ReformatParagraph(Buf,65,TempLines);
  443.       if TempLines.Count=0 then Lines.Add('')
  444.         else Lines.AddStrings(TempLines);
  445.     until (Stream.Position=Stream.Size) or Canceled;
  446.   finally
  447.     TempLines.Free;
  448.     StrDispose(Buf);
  449.   end;
  450. end;
  451.  
  452. procedure TQuotedPrintable.ReplaceHex(var s : string);
  453. var
  454.   i : byte;
  455.   sLen : byte absolute s;
  456.   Hex : byte;
  457. begin
  458.   i:=1;
  459.   while i<sLen do
  460.   begin
  461.     if (s[i]='=') then
  462.     begin
  463.       try
  464.         Hex:=StrToInt('$'+Copy(s,i+1,2));
  465.         Delete(s,i,3);
  466.         Insert(Char(Hex),s,i);
  467.       except
  468.         on EConvertError do {Do nothing}
  469.           else raise;
  470.       end;
  471.     end;
  472.     Inc(i);
  473.   end;
  474. end;
  475.  
  476. procedure TQuotedPrintable.Decode;
  477. var
  478.   Buf : PChar;
  479.   i : Integer;
  480.   Finished : boolean;
  481.   s : string;
  482.   sLen : byte absolute s;
  483. begin
  484.   Buf:=StrAlloc(BufSize);
  485.   i:=-1;
  486.   try
  487.     repeat
  488.       FillChar(Buf^,BufSize,0);
  489.       repeat
  490.         Inc(i);
  491.         s:=Lines[i];
  492.         ReplaceHex(s);
  493.         Finished:=(sLen=0) or (s[sLen]<>'=');
  494.         if not Finished then Dec(sLen)
  495.           else s:=Concat(s,^M^J);
  496.         s:=Concat(s,#00);
  497.         if StrLen(Buf)+sLen>=BufSize then
  498.           raise EMIMEError.Create('Paragraph is too large');
  499.         StrCat(Buf,@s[1]);
  500.       until Finished;
  501.       Stream.Write(Buf^,StrLen(Buf));
  502.       Application.ProcessMessages;
  503.     until (i=Lines.Count-1) or Canceled;
  504.   finally
  505.     StrDispose(Buf);
  506.   end;
  507. end;
  508.  
  509. function GetContentType(const FileName : string) : string;
  510. var
  511.   Ext : string[4];
  512. begin
  513.   Ext:=UpperCase(ExtractFileExt(FileName));
  514.   if Ext='.AIF' then result:='audio/aiff'
  515.   else
  516.   if (Ext='.AU') or (Ext='.SND') then result:='audio/basic'
  517.   else
  518.   if Ext='.GIF' then result:='image/gif'
  519.   else
  520.   if Ext='.JPG' then result:='image/jpeg'
  521.   else
  522.   if Ext='.AVI' then result:='video/avi'
  523.   else
  524.   if Ext='.RTF' then result:='text/rtf'
  525.   else
  526.   if Ext='.HTM' then result:='text/html'
  527.   else
  528.   if Ext='.TXT' then result:='text/plain'
  529.   else
  530.     result:='application/octet-stream';
  531. end;
  532.  
  533. function MakeUniqueID : string;
  534. var
  535.   i : Integer;
  536. begin
  537.   Randomize;
  538.   Result:='';
  539.   for i:=1 to 8 do
  540.     Result:=Concat(Result,IntToStr(Random(9)));
  541. end;
  542.  
  543. end.
  544.